home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / janusw.zip / DIALOGWN.PAS next >
Pascal/Delphi Source File  |  1992-07-26  |  12KB  |  387 lines
  1. Unit DialogWn;
  2. { Unit:      DialogWn
  3.   Version:   1.01
  4.   Purpose:   make a descendant of tWindow named tDialogWindow that behaves like
  5.              a modeless dialog.
  6.   Features:  - tDialogWindow descends from tWindow
  7.              - tDialogWindow and descendants may be used as MDI childs
  8.              - support for calculated resources is included e.g. a dialog
  9.                childs class & style may be changed on-the-fly (see GetChildClass)
  10.                tJanusDialogWindow object is an example for this: it decides at
  11.                runtime whether to uses BorDlg's or standard dialogs
  12.   Date:      26.07.1992
  13.  
  14.   Developer: Peter Sawatzki (PS) 
  15.              Buchenhof 3, D-5800 Hagen 1, Germany
  16.  CompuServe: 100031,3002
  17.        FIDO: 2:245/5800.17
  18.      BITNET: IN307@DHAFEU11
  19.  
  20.   Copyright (c) 1992 Peter Sawatzki. All Rights Reserved.
  21.  
  22.   Contributing: Jeroen W. Pluimers (jwp)
  23.                 CompuServe: 100013,1443
  24.                 Internet:   jeroenp@rulfc1.leidenuniv.nl
  25.                 Fidonet:    2:281/521
  26.  
  27.   History:   22.04.92 - intial release by PS
  28.              26.07.92 - added Scroller support by PS and jwp
  29.  
  30. }
  31. Interface
  32. Uses
  33.   WinTypes,
  34.   WObjects;
  35. Type
  36.   tChildClass = Record
  37.     wX, wY, wCX, wCY, wID: Integer;
  38.     dwStyle: LongInt;
  39.     szClass: Array[0..63] Of Char;
  40.     szTitle: Array[0..131] Of Char;
  41.     CtlDataSize: Byte;
  42.     CtlData: Array[0..255] Of Byte;
  43.   End;
  44.  
  45.   tDialogWindowAttr = Record
  46.     Name: pChar;
  47.     ItemCount: Integer;
  48.     MenuName,
  49.     ClassName,
  50.     FontName: pChar;
  51.     Font: hFont;
  52.     PointSize: Integer;
  53.     DlgItems: Pointer;
  54.     ResW,
  55.     ResH: Integer;
  56.     wUnitsX,
  57.     wUnitsY: Word
  58.   End;
  59.  
  60.   pDialogWindow = ^tDialogWindow;
  61.   tDialogWindow = Object(tWindow)
  62.     DialogAttr: tDialogWindowAttr;
  63.     Constructor Init (aParent: pWindowsObject; aName: pChar);
  64.     Destructor Done; Virtual;
  65.     Function  Create: Boolean;      Virtual;
  66.     Procedure Destroy;              Virtual;
  67.     Procedure SetupWindow;          Virtual;
  68.     Function  GetClassName: pChar;  Virtual;
  69.     Function  NewClassName: pChar;  Virtual;
  70.     Procedure SetClassName;         Virtual;
  71.     Procedure GetChildClass (Var aChildClass: tChildClass); Virtual;
  72.     Function  CreateDialogChild (Var aChildClass: tChildClass): hWnd; Virtual;
  73.     Procedure CreateDialogChildren;
  74.     Procedure CreateDialogFont;
  75.     Procedure GetDialogInfo (aPtr: Pointer);
  76.     Procedure UpdateDialog;
  77.     Procedure Ok (Var Msg: tMessage); Virtual id_First+id_Ok;
  78.     Procedure Cancel (Var Msg: tMessage); Virtual id_First+id_Cancel;
  79.     Procedure wmMDIActivate (Var Msg:  tMessage); Virtual wm_First+wm_MDIActivate;
  80.     (*Procedure wmNCActivate (Var Msg: tMessage); Virtual wm_First+$46;*)
  81.     procedure WMSize(var Msg: TMessage); virtual wm_First + wm_Size;
  82.   End;
  83.  
  84. Implementation
  85. Uses
  86.   WinProcs,
  87.   Strings;
  88. Const
  89.   sztDialogWindow = 'tDialogWindow';
  90.  
  91. Function DlgToClientX (x, Units: Integer): Integer;
  92. {DlgToClientX:= x*Units Div 4}
  93. Inline($59/$58/    {Pop Cx Ax}
  94.        $F7/$E1/    {Mul Cx}
  95.        $D1/$E8/    {Shr Ax,1}
  96.        $D1/$E8);   {Shr Ax,1}
  97.  
  98. Function DlgToClientY (y, Units: Integer): Integer;
  99. {DlgToClientY:= y*Units Div 8}
  100. Inline($59/$58/    {Pop Cx Ax}
  101.        $F7/$E1/    {Mul Cx}
  102.        $D1/$E8/    {Shr Ax,1}
  103.        $D1/$E8/    {Shr Ax,1}
  104.        $D1/$E8);   {Shr Ax,1}
  105.  
  106. Constructor tDialogWindow.Init (aParent: pWindowsObject; aName: pChar);
  107. Begin
  108.   tWindow.Init(aParent,sztDialogWindow); {fake title}
  109.   FillChar(DialogAttr,SizeOf(DialogAttr),0);
  110.   With DialogAttr Do
  111.     If PtrRec(aName).Seg=0 Then Name:= aName Else Name:= StrNew(aName)
  112. End;
  113.  
  114. Destructor tDialogWindow.Done;
  115. Begin
  116.   With DialogAttr Do Begin
  117.     If PtrRec(Name).Seg<>0 Then StrDispose(Name);
  118.     StrDispose(MenuName);
  119.     StrDispose(ClassName);
  120.     If FontName<>Nil Then
  121.       StrDispose(FontName)
  122.   End;
  123.   tWindow.Done
  124. End;
  125.  
  126. Function tDialogWindow.Create: Boolean;
  127. Var
  128.   aRes: tHandle;
  129. Begin
  130.   EnableKBHandler;
  131.   If DialogAttr.Name=Nil Then
  132.     Exit;
  133.   aRes:= LoadResource(hInstance,
  134.                       FindResource(hInstance, DialogAttr.Name, rt_Dialog));
  135.   If aRes=0 Then
  136.     Status:= em_InvalidWindow
  137.   Else Begin
  138.     GetDialogInfo(LockResource(aRes));
  139.     SetClassName; {let descendants change the class name}
  140.     CreateDialogFont;
  141.     UpdateDialog;
  142.     Create:= tWindow.Create;
  143.     UnlockResource(aRes);
  144.     FreeResource(aRes)
  145.   End
  146. End;
  147.  
  148. Procedure tDialogWindow.Destroy;
  149. Begin
  150.   If DialogAttr.FontName<>Nil Then
  151.     DeleteObject(DialogAttr.Font);
  152.   tWindow.Destroy
  153. End;
  154.  
  155. Procedure tDialogWindow.SetupWindow;
  156. const
  157.   BorDialog = 'BorDlg';
  158. Begin
  159.   SendMessage(hWindow,wm_SetFont,DialogAttr.Font,0);
  160.   CreateDialogChildren;
  161.   tWindow.SetupWindow;
  162.   If  (Scroller<>Nil)
  163.   And (StrLIComp(DialogAttr.ClassName,BorDialog,Length(BorDialog)) = 0) Then
  164.   With Scroller^ Do Begin
  165.     {fix BWCC background quirk}
  166.     XUnit:= (XUnit + 1) And Not 1; { make even }
  167.     YUnit:= (YUnit + 1) And Not 1
  168.   End
  169. End;
  170.  
  171. Function tDialogWindow.GetClassName: pChar;
  172. Begin
  173.   If NewClassName=Nil Then
  174.     If DialogAttr.ClassName=Nil Then
  175.       GetClassName:= sztDialogWindow
  176.     Else
  177.       GetClassName:= DialogAttr.ClassName
  178.   Else
  179.     GetClassName:= NewClassName
  180. End;
  181.  
  182. Function tDialogWindow.NewClassName: pChar;
  183. Begin
  184.   {-tDialogWindow gets the Class name from the dialog resource}
  185.   NewClassName:= Nil
  186. End;
  187.  
  188. Procedure tDialogWindow.SetClassName;
  189. Begin
  190.   If NewClassName<>Nil Then Begin
  191.     StrDispose(DialogAttr.ClassName);
  192.     DialogAttr.ClassName:= StrNew(NewClassName)
  193.   End
  194. End;
  195.  
  196. Procedure tDialogWindow.GetChildClass (Var aChildClass: tChildClass);
  197. {-change a childs window class. Standard windows behaviour is simulated here:
  198.   change special resource shortcuts (#$80..#$85) to their appropriate class names}
  199. Const
  200.   PreDefClasses: Array[#$80..#$85] Of pChar =
  201.     ('BUTTON','EDIT','STATIC','LISTBOX','SCROLLBAR','COMBOBOX');
  202. Begin
  203.   With aChildClass Do
  204.     Case szClass[0] Of
  205.       #$80..#$85: StrCopy(szClass,PreDefClasses[szClass[0]])
  206.     End
  207. End;
  208.  
  209. Function tDialogWindow.CreateDialogChild (Var aChildClass: tChildClass): hWnd;
  210. Var
  211.   aCtl: hWnd;
  212.   lpDlgItemInfo: Pointer;
  213. Begin
  214.   With DialogAttr, aChildClass Do Begin
  215.     If CtlDataSize=0 Then
  216.       lpDlgItemInfo:= Nil
  217.     Else
  218.       lpDlgItemInfo:= @CtlData;
  219.     aCtl:= CreateWindow(szClass, szTitle, dwStyle,
  220.                         DlgToClientX(wX,wUnitsX),  DlgToClientY(wY,wUnitsY),
  221.                         DlgToClientX(wCX,wUnitsX), DlgToClientY(wCY,wUnitsY),
  222.                         hWindow, wID, System.hInstance,
  223.                         lpDlgItemInfo);
  224.     If aCtl<>0 Then
  225.       SendMessage(aCtl, wm_SetFont, Font, 0)
  226.   End;
  227.   CreateDialogChild:= aCtl
  228. End;
  229.  
  230. Procedure tDialogWindow.CreateDialogChildren;
  231. Var
  232.   i: Integer;
  233.   sp: Pointer;
  234.   anItem: tChildClass;
  235. Begin
  236.   sp:= DialogAttr.DlgItems;
  237.   With DialogAttr,anItem Do
  238.   For i:= 1 To DialogAttr.ItemCount Do Begin
  239.     {-copy fixed header and first byte of szClass}
  240.     Move(sp^,anItem,15); Inc(Word(sp),15);
  241.     Case szClass[0] Of
  242.       #$80..#$85: szClass[1]:= #0;   {be safe}
  243.     Else
  244.       StrCopy(szClass+1,sp);       {copy rest of classname}
  245.       Inc(Word(sp),StrLen(sp)+1)
  246.     End;
  247.     StrCopy(szTitle,sp); Inc(Word(sp),StrLen(sp)+1);
  248.     Move(sp^,CtlDataSize,Byte(sp^)+1);
  249.     Inc(Word(sp),CtlDataSize+1);
  250.     {-maybe a descendant class wants to change child names :-) }
  251.     GetChildClass(anItem);
  252.     If CreateDialogChild(anItem)=0 Then Begin
  253.       Status:= em_InvalidChild;
  254.       Exit
  255.     End
  256.   End
  257. End;
  258.  
  259. Procedure tDialogWindow.GetDialogInfo (aPtr: Pointer);
  260. Begin
  261.   With Attr,DialogAttr Do Begin
  262.     Style:= LongInt(aPtr^);   Inc(Word(aPtr),SizeOf(LongInt));
  263.     ItemCount:= Byte(aPtr^);  Inc(Word(aPtr),SizeOf(Byte));
  264.     If Not IsFlagSet(wb_MdiChild) Then
  265.       X:= Integer(aPtr^);     Inc(Word(aPtr),SizeOf(Integer));
  266.     Y:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  267.     W:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  268.     H:= Integer(aPtr^);       Inc(Word(aPtr),SizeOf(Integer));
  269.     MenuName:= StrNew(aPtr);  Inc(Word(aPtr),StrLen(aPtr)+1);
  270.     ClassName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1);
  271.     Title:= StrNew(aPtr);     Inc(Word(aPtr),StrLen(aPtr)+1);
  272.     If Style And ds_SetFont>0 Then Begin
  273.       PointSize:= Integer(aPtr^); Inc(Word(aPtr),SizeOf(Integer));
  274.       FontName:= StrNew(aPtr); Inc(Word(aPtr),StrLen(aPtr)+1)
  275.     End Else Begin
  276.       PointSize:= 0;
  277.       FontName:= Nil
  278.     End;
  279.     DlgItems:= aPtr
  280.   End
  281. End;
  282.  
  283. Procedure tDialogWindow.UpdateDialog;
  284. {-update and resize dialog window according to its style}
  285. Var
  286.   TheMDIClient: pMdiClient;
  287.   aRect: tRect;
  288. Begin With Attr, DialogAttr Do Begin
  289.   {-update style bits for MDI}
  290.   If isFlagSet(wb_MdiChild) Then Begin
  291.     {-reject use of ws_PopUp for a MDI child!}
  292.     If Style And ws_PopUp<>0 Then
  293.       Style:= (Style Or ws_Child) And Not ws_PopUp;
  294.     TheMDIClient:= Parent^.GetClient;
  295.     {-check if the Client window has the MDIs_allChildStyles bit set}
  296.     If (TheMDIClient=Nil)
  297.     Or (GetWindowLong(TheMDIClient^.hWindow,gwl_Style) And 1=0) Then
  298.       Style:= Style Or ws_Child Or ws_ClipSiblings Or ws_ClipChildren
  299.                     Or ws_SysMenu Or ws_Caption Or ws_ThickFrame
  300.                     Or ws_MinimizeBox Or ws_MaximizeBox
  301.   End;
  302.  
  303.   {-resize the window according to its style and size}
  304.   With aRect Do Begin
  305.     left:= 0;
  306.     top:= 0;
  307.     right:=  DlgToClientX(w, wUnitsX);
  308.     bottom:= DlgToClientY(h, wUnitsY);
  309.     AdjustWindowRect(aRect, Style, Menu<>0);
  310.     w:= right-left;
  311.     h:= bottom-top;
  312.     ResW:= w;
  313.     ResH:= h;
  314.   End
  315. End End;
  316.  
  317. Procedure tDialogWindow.CreateDialogFont;
  318. {-create the dialog font and calculate dialog units based on font}
  319. Const
  320.   aWidthString = 'ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz';
  321. Var
  322.   aDC: hDC;
  323.   anOldFont: hFont;
  324.   aLogFont: tLogFont;
  325.   aTextMetric: tTextMetric;
  326. Begin With DialogAttr Do Begin
  327.   aDC:= GetDC(0);
  328.   If FontName=Nil Then
  329.     Font:= GetStockObject(System_Font)
  330.   Else Begin
  331.     FillChar(aLogFont,SizeOf(aLogFont),0);
  332.     With aLogFont Do Begin
  333.       StrCopy(lfFaceName,FontName);
  334.       lfHeight:= -MulDiv(DialogAttr.PointSize,GetDeviceCaps(aDC, LogPixelsY),72);
  335.       lfWeight:= FW_BOLD
  336.     End;
  337.     Font:= CreateFontIndirect(aLogFont)
  338.   End;
  339.   anOldFont:= SelectObject(aDC, Font);
  340.   GetTextMetrics(aDC, aTextMetric);
  341.   {-use the Microsoft recommended way to retrieve average width}
  342.   wUnitsX:= Word(GetTextExtent(aDC, aWidthString, Length(aWidthString))) Div Length(aWidthString);
  343.   wUnitsY:= aTextMetric.tmHeight;
  344.   SelectObject(aDC, anOldFont);
  345.   ReleaseDC(0, aDC)
  346. End End;
  347.  
  348. Procedure tDialogWindow.Ok (Var Msg: tMessage);
  349. Begin
  350.   CloseWindow
  351. End;
  352.  
  353. Procedure tDialogWindow.Cancel (Var Msg: tMessage);
  354. Begin
  355.   CloseWindow
  356. End;
  357.  
  358. Procedure tDialogWindow.wmMDIActivate(Var Msg:  tMessage);
  359. Begin
  360.   wmActivate(Msg)
  361. End;
  362.  
  363. (*Procedure tDialogWindow.wmNCActivate(Var Msg:  tMessage);
  364. Begin
  365.   {If Msg.wParam=0 Then}
  366.     Msg.Result:= 0
  367.   {Else
  368.     With Msg Do Result:= DefWindowProc(Receiver, Message, wParam, lParam)
  369.   }
  370. End; *)
  371.  
  372. Procedure tDialogWindow.WMSize(var Msg: TMessage);
  373. Begin
  374.   TWindow.WMSize(Msg);
  375.   If Scroller <> Nil Then With Scroller^ Do Begin
  376.     AutoOrg:= Msg.wParam <> sizeIconic;
  377.     If Msg.WParam <> sizeIconic Then Begin
  378.       With DialogAttr, Attr Do
  379.         SetRange(ResW - W, ResH - H);
  380.       ScrollTo(0, 0);
  381.       InvalidateRect(HWindow, nil, True)
  382.     End
  383.   End
  384. End;
  385.  
  386. End.
  387.